home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / ownrdr.exe / OWNRDRAW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-04  |  4.8 KB  |  156 lines
  1. unit OwnrDraw;
  2. { This unit allows you to create BWCC style buttons without using BWCC.DLL.
  3.   It is by Todd T. Snoddy, and the source code is Copyright ⌐ Todd T. Snoddy.
  4.   You may use this unit as you like in your own programs.  I can be contacted via
  5.   Compuserve email at 71044,1653. }
  6.  
  7. interface
  8.  
  9. uses WObjects, WinTypes, WinProcs;
  10.  
  11. type ButtonState = (Normal, Focused, Pressed);
  12.  
  13. type
  14.   PODButton = ^TODButton;
  15.   TODButton = object(TButton)
  16.     HNormal, HPressed, HFocused :HBitmap;
  17.     State:ButtonState;
  18.     InitialDefault, IsCreating, HasCreated : Boolean;
  19.     constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  20.       X,Y,W,H:Integer;IsDefault:Boolean;BMP:Integer);
  21.     constructor InitResource (AParent : PWindowsObject; ResourceID : Word; IsDefault : Boolean);
  22.     destructor Done;virtual;
  23.     procedure DrawItem(var Msg:TMessage);virtual;
  24.     procedure WMDrawItem (var Msg : TMessage); virtual wm_First+wm_DrawItem;
  25.     procedure WMSetFocus (var Msg : TMessage); virtual wm_First+wm_SetFocus;
  26.   end;
  27.  
  28. type
  29.   POwnerDialog = ^TOwnerDialog;
  30.   TOwnerDialog = object (TDialog)
  31.     Button : PODButton;
  32.     procedure WMDrawItem (var Msg : TMessage); virtual wm_First+wm_DrawItem;
  33.     procedure NewButton (ID : Integer; IsDefault : Boolean);
  34.   end;
  35.  
  36.  
  37. implementation
  38.  
  39. procedure TOwnerDialog.WMDrawItem(var Msg:TMessage);
  40. var
  41.   PDrawStruct : ^TDrawItemStruct;
  42. begin
  43.   PDrawStruct := Pointer(Msg.lParam);
  44.   case PDrawStruct^.CtlType of
  45.     odt_Button:  SendDlgItemMsg (PDrawStruct^.CtlID, wm_DrawItem, Msg.wParam, Msg.lParam);
  46.   end;
  47. end;
  48.  
  49. procedure TOwnerDialog.NewButton (ID :  Integer; IsDefault : Boolean);
  50. begin
  51.   Button := New (PODButton, InitResource (@Self, ID, IsDefault));
  52. end;
  53.  
  54. constructor TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  55.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:Integer);
  56. begin
  57.   TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  58.   Attr.Style := Attr.Style or bs_OwnerDraw;
  59.   IsCreating := True;
  60.   HasCreated := False;
  61.   if IsDefault then
  62.     InitialDefault := True
  63.   else
  64.     InitialDefault := False;
  65.   HNormal := LoadBitmap(HInstance, MakeIntResource (BMP+1000));
  66.   HPressed := LoadBitmap (HInstance, MakeIntResource (BMP+3000));
  67.   HFocused := LoadBitmap (HInstance, MakeIntResource (BMP+5000));
  68. end;
  69.  
  70. constructor TODButton.InitResource (AParent : PWindowsObject; ResourceID : Word; IsDefault : Boolean);
  71. begin
  72.   TButton.InitResource (AParent, ResourceID);
  73.   IsCreating := True;
  74.   HasCreated := False;
  75.   Attr.Style := Attr.Style or bs_OwnerDraw;
  76.   if IsDefault then
  77.     InitialDefault := True
  78.   else
  79.     InitialDefault := False;
  80.   HNormal := LoadBitmap(HInstance, MakeIntResource (ResourceID+1000));
  81.   HPressed := LoadBitmap (HInstance, MakeIntResource (ResourceID+3000));
  82.   HFocused := LoadBitmap (HInstance, MakeIntResource (ResourceID+5000));
  83. end;
  84.  
  85. destructor TODButton.Done;
  86. begin
  87.   TButton.Done;
  88.   DeleteObject(HNormal);
  89.   DeleteObject (HFocused);
  90.   DeleteObject (HPressed);
  91. end;
  92.  
  93. procedure TODButton.WMDrawItem (var Msg : TMessage);
  94. begin
  95.   DrawItem (Msg);
  96. end;
  97.  
  98. procedure TODButton.WMSetFocus (var Msg : TMessage);
  99. begin
  100.   InvalidateRect (HWindow, nil, False);
  101.   UpdateWindow (HWindow);
  102.   DefWndProc (Msg);
  103. end;
  104.  
  105. procedure TODButton.DrawItem(var Msg:TMessage);
  106. var
  107.   OldBitMap:HBitMap;
  108.   MemDC :HDC;
  109.   PDrawStruct :^TDrawItemStruct;
  110.   X,Y,W,H:Integer;
  111.  
  112. begin
  113.   PDrawStruct := Pointer(Msg.lParam);
  114.   State := Normal;
  115.   if (PDrawStruct^.itemAction and oda_Select ) > 0 then
  116.     begin
  117.       if (PDrawStruct^.itemState and ods_Selected) > 0 then
  118.         State :=  Pressed
  119.       else
  120.         if (PDrawStruct^.itemState and ods_Focus) > 0 then
  121.           State := Focused
  122.         else
  123.           State := Normal;
  124.     end;
  125.   if ((PDrawStruct^.itemAction and oda_Focus) > 0)
  126.     and not ((PDrawStruct^.itemAction and oda_Select) > 0) then
  127.       begin
  128.         if (PDrawStruct^.itemState and ods_Focus) > 0 then
  129.           State := Focused
  130.         else
  131.           State := Normal;
  132.       end;
  133.   X := PDrawStruct^.rcItem.left;Y := PDrawStruct^.rcItem.top;
  134.   W := PDrawStruct^.rcItem.right-PDrawStruct^.rcItem.left;
  135.   H := PDrawStruct^.rcItem.bottom-PDrawStruct^.rcItem.top;
  136.   MemDC := CreateCompatibleDC(PDrawStruct^.HDC);
  137.   { Following bitmaps are already initialized in InitResource }
  138.   if IsCreating and InitialDefault and HasCreated then
  139.     begin
  140.       IsCreating := False;
  141.       State := Focused;
  142.     end;
  143.   case State of
  144.     Normal : OldBitMap := SelectObject (MemDC, HNormal);
  145.     Pressed : OldBitMap := SelectObject (MemDC, HPressed);
  146.     Focused : OldBitMap := SelectObject (MemDC, HFocused);
  147.   end;
  148.   BitBlt (PDrawStruct^.HDC, X, Y, W, H, MemDC, 0, 0, SrcCopy);
  149.   SelectObject(MemDC,OldBitMap);
  150.   DeleteDC(MemDC);
  151.   HasCreated := True;
  152.   Msg.Result := 1;
  153. end;
  154.  
  155. end.
  156.